home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 26
/
Cream of the Crop 26.iso
/
bbs
/
tdk_v136.zip
/
FOSUNIT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-12-23
|
8KB
|
355 lines
{
▀▀▀▀▀▀▀▀ ▀▀▀▀▀▀ ▀▀ ▀▀
▀▀ ▀▀ ▀▀ ▀▀ ▀▀
▀▀ ▀▀ ▀▀▀ ▀▀▀▀▀ The DoorKit!
▀▀ ▀▀ ▀▀ ▀▀ ▀▀
▀▀ ▀▀▀▀▀▀ ▀▀ ▀▀
The BBS Door Development Kit By The People - For The People!
Feel free to modify or optimize this code at will. All I ask is that if
find a better way to do things (and you will), please send me a copy of
your modifications. Thanks in advance!....Larry L. Athey....}
{$A+,B-,D+,E+,F+,G+,I-,L+,N-,O+,P-,Q-,R-,S-,T-,V+,X+}
UNIT FOSUNIT;
INTERFACE
USES DOS;
TYPE
ASCIZ_id = ARRAY[1..128] OF CHAR;
ascizptr = ^asciz_id;
fossildatatype = RECORD
strsize : WORD;
majver : BYTE;
minver : BYTE;
ident : ascizPtr;
ibufr : WORD;
ifree : WORD;
obufr : WORD;
ofree : WORD;
swidth : BYTE;
sheight : BYTE;
baud : BYTE;
END;
VAR
port_num : INTEGER;
fossildata : fossildatatype;
PROCEDURE async_send(c : CHAR);
PROCEDURE async_send_string(s : STRING);
FUNCTION async_receive(VAR ch : CHAR) : BOOLEAN;
FUNCTION async_carrier_drop : BOOLEAN;
FUNCTION async_carrier_present : BOOLEAN;
FUNCTION async_buffer_check : BOOLEAN;
FUNCTION async_init_fossil : BOOLEAN;
PROCEDURE async_deinit_fossil;
PROCEDURE async_flush_output;
PROCEDURE async_purge_output;
PROCEDURE async_purge_input;
PROCEDURE async_set_dtr(state : BOOLEAN);
PROCEDURE async_watchdog_on;
PROCEDURE async_watchdog_off;
PROCEDURE async_warm_reboot;
PROCEDURE async_cold_reboot;
PROCEDURE async_set_baud(n : LONGINT);
PROCEDURE async_set_baudBnu(n : LONGINT);
PROCEDURE async_set_flow(SoftTran,Hard,SoftRecv : BOOLEAN);
PROCEDURE async_buffer_status(VAR Insize,Infree,OutSize,Outfree : WORD;
VAR fossilname : STRING);
IMPLEMENTATION
PROCEDURE async_send(c : CHAR);
VAR
regs : REGISTERS;
BEGIN;
WITH regs DO
BEGIN
ah := $01;
al := BYTE(c);
dx := port_num;
END;
INTR($14,regs);
END;
PROCEDURE async_send_string(s : STRING);
VAR
a : INTEGER;
BEGIN;
FOR a := 1 TO LENGTH(s) DO async_send(s[a]);
END;
FUNCTION async_receive(VAR ch : CHAR) : BOOLEAN;
VAR
regs : REGISTERS;
BEGIN;
ch := #0;
regs.ah := $03;
regs.dx := port_num;
INTR($14,regs);
IF (regs.ah AND 1) = 1 THEN BEGIN;
regs.ah := $02;
regs.dx := port_num;
INTR($14,regs);
ch := CHR(regs.al);
async_receive := TRUE;
END ELSE async_receive := FALSE;
END;
FUNCTION async_carrier_drop : BOOLEAN;
VAR
regs : REGISTERS;
BEGIN;
regs.ah := $03;
regs.dx := port_num;
INTR($14,regs);
IF (regs.al AND $80) <> 0 THEN async_carrier_drop := FALSE ELSE async_carrier_drop := TRUE;
END;
FUNCTION async_carrier_present : BOOLEAN;
VAR
regs : REGISTERS;
BEGIN;
regs.ah := $03;
regs.dx := port_num;
INTR($14,regs);
IF (regs.al AND $80) <> 0 THEN async_carrier_present := TRUE ELSE async_carrier_present := FALSE;
END;
FUNCTION async_buffer_check : BOOLEAN;
VAR
regs : REGISTERS;
BEGIN;
regs.ah := $03;
regs.dx := port_num;
INTR($14,regs);
IF (regs.ah AND 1) = 1 THEN async_buffer_check := TRUE ELSE async_buffer_check := FALSE;
END;
FUNCTION async_init_fossil : BOOLEAN;
VAR
regs : REGISTERS;
BEGIN;
regs.ah := $04;
regs.bx := $00;
regs.dx := port_num;
INTR($14,regs);
IF regs.ax = $1954 THEN async_init_fossil := TRUE ELSE async_init_fossil := FALSE;
END;
PROCEDURE async_deinit_fossil;
VAR
regs : REGISTERS;
BEGIN;
regs.ah := $05;
regs.dx := port_num;
INTR($14,regs);
END;
PROCEDURE async_set_dtr(state : BOOLEAN);
VAR
regs : REGISTERS;
BEGIN;
regs.ah := $06;
IF state THEN regs.al := 1 ELSE regs.al := 0;
regs.dx := port_num;
INTR($14,regs);
END;
PROCEDURE async_flush_output;
VAR
regs : REGISTERS;
BEGIN;
regs.ah := $08;
regs.dx := port_num;
INTR($14,regs);
END;
PROCEDURE async_purge_output;
VAR
regs : REGISTERS;
BEGIN;
regs.ah := $09;
regs.dx := port_num;
INTR($14,regs);
END;
PROCEDURE async_purge_input;
VAR
regs : REGISTERS;
BEGIN;
regs.ah := $0A;
regs.dx := port_num;
INTR($14,regs);
END;
PROCEDURE async_watchdog_on;
VAR
regs : REGISTERS;
BEGIN;
regs.ah := $14;
regs.al := $01;
regs.dx := port_num;
INTR($14,regs);
END;
PROCEDURE async_watchdog_off;
VAR
regs : REGISTERS;
BEGIN;
regs.ah := $14;
regs.al := $00;
regs.dx := port_num;
INTR($14,regs);
END;
PROCEDURE async_warm_reboot;
VAR
regs : REGISTERS;
BEGIN;
regs.ah := $17;
regs.al := $01;
INTR($14,regs);
END;
PROCEDURE async_cold_reboot;
VAR
regs : REGISTERS;
BEGIN;
regs.ah := $17;
regs.al := $00;
INTR($14,regs);
END;
PROCEDURE async_set_baud(n : LONGINT);
VAR
w : WORD;
regs : REGISTERS;
BEGIN;
regs.ah := $00;
regs.al := $03;
regs.dx := port_num;
w := n;
IF n > 76800 THEN {115200 }
regs.al := regs.al OR $80
ELSE
IF n > 57600 THEN { 76800 }
regs.al := regs.al OR $60
ELSE
CASE w OF
300 : regs.al := regs.al OR $40;
600 : regs.al := regs.al OR $60;
1200 : regs.al := regs.al OR $80;
2400 : regs.al := regs.al OR $A0;
4800 : regs.al := regs.al OR $C0;
9600 : regs.al := regs.al OR $E0;
9601..19200 : regs.al := regs.al OR $00;
19201..38400 : regs.al := regs.al OR $20;
38401..57600 : regs.al := regs.al OR $40;
END;
INTR($14,regs);
END;
PROCEDURE async_set_baudBnu(n : LONGINT);
VAR
w : WORD;
regs : REGISTERS;
BEGIN;
regs.ah := $00;
regs.al := $03;
regs.dx := port_num;
w := n;
IF n > 38400 THEN
BEGIN
IF n > 57600 THEN {115200}
regs.al := regs.al OR $80
ELSE
regs.al := regs.al OR $60; { 57600 }
regs.bx := $69DC;
regs.cx := $69DC;
END
ELSE
CASE w OF
300 : regs.al := regs.al OR $40;
600 : regs.al := regs.al OR $60;
1200 : regs.al := regs.al OR $80;
2400 : regs.al := regs.al OR $A0;
4800 : regs.al := regs.al OR $C0;
9600 : regs.al := regs.al OR $E0;
9601..19200 : regs.al := regs.al OR $00;
19201..38400 : regs.al := regs.al OR $20;
END;
INTR($14,regs);
END;
{
The "enhanced" port rate settings are accessed by setting the both BX
and CX CPU registeres to the magic value 0x69dc when calling Fn 0 (INT
14H, AH=0). This changes the meaning of the meaning of the three bits
used to set the baud rate, bits 5-7, according to this table:
Value Standard Enhanced (BX=CX=69DCh)
----- -------- --------
000 19200 75
001 38400 110
010 300 7200
011 600 57600
100 1200 115200
101 2400 |
110 4800 | undefined
111 9600 |
david }
PROCEDURE async_set_flow(SoftTran,Hard,SoftRecv : BOOLEAN);
VAR
regs : REGISTERS;
BEGIN;
regs.ah := $0F;
regs.al := $00;
IF softtran THEN regs.al := regs.al OR $01;
IF Hard THEN regs.al := regs.al OR $02;
IF SoftRecv THEN regs.al := regs.al OR $08;
regs.al := regs.al OR $F0;
INTR($14,regs);
END;
PROCEDURE async_get_fossil_data;
VAR
regs : REGISTERS;
BEGIN;
regs.ah := $1B;
regs.cx := SIZEOF(fossildata);
regs.dx := port_num;
regs.es := SEG(fossildata);
regs.di := OFS(fossildata);
INTR($14,regs);
END;
PROCEDURE Async_Buffer_Status(VAR Insize,Infree,OutSize,Outfree : WORD;
VAR fossilname : STRING);
VAR
i : BYTE;
BEGIN;
async_get_fossil_data;
insize := fossildata.ibufr;
infree := fossildata.ifree;
outsize := fossildata.obufr;
outfree := fossildata.ofree;
i := 1;
WHILE (i < 62) AND (fossildata.ident^[i] <> #0) DO
INC(i);
MOVE(fossildata.ident^, fossilname[1], i);
fossilname[0] := CHAR(i);
END;
END.